C  MODPATH release: Version 4.00 (V4, Release 2, 4-2001)
C    Use flat binary files on personal computers
C    Always write head into composite budget file even for confined cells
C  MODPATH release: Version 4.00 (V4, Release 1, 12-2000)
C Changes -- ADDQAR modified to set IBOUND=IBOUND*1000 for weak sinks
C  MODPATH release: Version 4.00 (V4, Release 1, 2-2000)
C Changes:
C   Modifications were made to work with MODFLOW-2000.
C   These changes have the following overall impact on MODPATH:
C       MAIN data file is reduced in size
C       Grid spacing is read from the MODFLOW discretization file
C       There is no longer a need for MODPATH to read MODFLOW's stress files.
C       The significant changes are in files:
C    MPATH4LF.FOR
C    DIS2.FOR -- new file-- routines that read MODFLOW-2000 discretization file
C    BUDGETRD.FOR -- new file-- routines for reading budget data (formerly in utilmp)
C    UTILMP.FOR
C    FLOWDATA.FOR
C    MPDRIVE.FOR
C    MPDATIN.FOR
C    MPINIT.FOR
C
C Previous release: Version 3.00 (V3, Release 2, 5-99)
C Changes:
C   Modifications from the previous release were made to the following 
C   modules:
C     FLOWDATA.FOR
C     UTILMP.FOR
C     SYSLF.FOR
C   For detailed descriptions of the changes, see the version notes
C   that are recorded at the beginning of each of those module files
C Previous release: MODPATH Version 3.00 (V3, Release 1, 9-94)
C***********************************************************************
C                       MODPATH Main Program
C***********************************************************************
      CHARACTER*256 RSPFIL  ! emrl 80 to 256
      CHARACTER*25 CUNIT(25)
      CHARACTER*256 VER(1),FHELP,FSHELP,PRGNAM,FNAMS ! emrl 80 to 256
      CHARACTER*132 FILDIR,PHELP,PSHELP
      INTEGER MAXSIZ
C
C----- REDIMENSION ARRAY "A" BY CHANGING THE NEXT TWO STATEMENTS ----
C----- MAKE SURE THAT LENA IS SET EQUAL TO THE LENGTH OF THE A ARRAY ---
C#STANDARD - BEGIN#  SET A FIXED DIMENSION FOR ARRAY "A"
c      COMMON A(8000000)
c      PARAMETER(LENA=8000000)
C#STANDARD - END#
C
C#LAHEY - BEGIN#  ALLOCATE MEMORY FOR ARRAY "A" DYNAMICALLY
      DIMENSION A(:)
      ALLOCATABLE :: A
      PARAMETER(LENA=15000000)
C#LAHEY - END#
 
C-----------------------------------------------------------------------
      INCLUDE 'idat1.inc'
      COMMON/FILDIR/ FILDIR
      COMMON /DFNAMS/ FNAMS(6)
      DIMENSION IUNIT(25),IUNAR(25)
      COMMON /MAXSIZ/ MAXSIZ
      DIMENSION LAYCBD(200)
C-----------------------------------------------------------------------
 
C#LAHEY - BEGIN#  SET CARRIAGE CONTROL SO THAT PROMPTS DISPLAY PROPERLY
c emrl jig      OPEN(UNIT=*,CARRIAGECONTROL='LIST')
      OPEN(UNIT=51,CARRIAGECONTROL='LIST')
C#LAHEY - END#
 
C    SET VERSION NUMBER
C
      VER(1)='MODPATH Version 4.00 (V4, Release 2, 4-2001)'
      PRGNAM=VER(1)
 
C... SET NUMBER OF UNITS RESERVED BY MODPATH. USED TO DIMENSION THE ARRAY
C    IUNAR WHICH CONTAINS THE UNIT NUMBERS
      NIUNAR=15
 
C... SET DEFAULT SIZE FOR MAXIMUM NUMBER OF PARTICLES
C      THE VALUE OF MAXPTS SHOULD BE SET TO A RELATIVELY SMALL NUMBER
C      ON SYSTEMS THAT ARE SET UP TO TAKE ADVANTAGE OF DYNAMIC MEMORY
C      ALLOCATION.
C
      MAXPTS=500000
 
C... SET DEFAULT MAXIMUM SIZE OF THE DIRECT ACCESS COMPOSITE DATA FILE
      MAXSIZ= 15000000
 
C... SET DEFAULT NAME OF RESPONSE FILE
      RSPFIL='mpath.rsp'
 
C... SET DEFAULT NAME OF HELP FILE
      FHELP= 'mpath.hlp'
 
C... SET DEFAULT NAME OF SUPPLEMENTAL HELP FILE
      FSHELP= 'mpath.shp'
 
C... SET CONVERSION FACTOR FOR DETERMINING RECORD LENGTH OF DIRECT
C    ACCESS COMPOSITE BUDGET FILE.
C    SET IBYTES=1  IF RECORD LENGTH IS BASED ON BYTES.
C    SET IBYTES=4  IF RECORD LENGTH IS BASED ON 4-BYTE WORDS.
C    SET IBYTES=2  IF RECORD LENGTH IS BASED ON 2-BYTE WORDS.
 
      IBYTES=1
 
C
C  SET UNIT NUMBERS FOR SCREEN I/O AND FILES THAT ARE SPECIFIED BY
C  INTERACTIVE I/O
C
C  I0 IS THE UNIT NUMBER OF FILE CONTAINING FILE NAMES AND UNIT NUMBERS
      I0=91
      IUNAR(1)=I0
C  I2 IS THE UNIT NUMBER FOR THE "PATHLINE"  FILE
      I2=92
      IUNAR(2)=I2
C  I3 IS THE UNIT NUMBER FOR THE "ENDPOINT"  FILE
      I3=93
      IUNAR(3)=I3
C  I4 IS THE UNIT NUMBER FOR THE "TIMESERS"   FILE
      I4=94
      IUNAR(4)=I4
C  I5 IS THE UNIT NUMBER FOR A SCRATCH FILE
      I5=95
      IUNAR(5)=I5
C  I6 IS THE UNIT NUMBER FOR THE STARTING LOCATIONS FILE
      I6=96
      IUNAR(6)=I6
C  I7 IS THE UNIT NUMBER FOR THE "SUMMARY.PTH"  FILE
      I7=97
      IUNAR(7)=I7
C  I8 IS THE UNIT NUMBER FOR THE TIME STEP FILE
      I8=98
      IUNAR(8)=I8
C  I9 IS THE UNIT NUMBER FOR THE FILE <MPBATCH>. IF <MPBATCH> EXISTS
C     AND HAS THE WORD "BATCH" AS THE FIRST ARGUMENT ON LINE 1, THE
C     PROGRAM RUNS IN SILENT MODE AND SCREEN OUTPUT IS SUPPRESSED.
C     IF <MPBATCH> DOES NOT EXIST OR IF IT DOES NOT START WITH THE
C     WORD "BATCH" ON LINE 1, MODPATH RUNS IN NORMAL MODE.
C
      I9=99
      IUNAR(9)=I9
C  I10 IS THE UNIT NUMBER FOR THE COMPOSITE BUDGET FILE (CBF), WHICH IS
c      A DIRECT ACCESS FILE CONTAINING FLOW AND HEAD DATA
      I10=90
      IUNAR(10)=I10
C
C  IUNAR(11) IS THE UNIT NUMBER FOR THE RESPONSE FILE
      IUNAR(11)=85
C  IUNAR(12) IS THE UNIT NUMBER FOR THE STRIPPED SCRATCH RESPONSE FILE
      IUNAR(12)=86
C  IUNAR(13) IS THE UNIT NUMBER FOR THE HELP FILE
      IUNAR(13)=87
C  IUNAR(14) IS THE UNIT NUMBER FOR THE SEARCH PATH FILE <MPSEARCH>
      IUNAR(14)=88
C  IUNAR(15) IS THE UNIT NUMBER FOR THE SECONDARY HELP FILE
      IUNAR(15)=89
 
C  SET CBF, LOCATIONS, AND TIME FILE NAMES TO BLANK
      DO 5 N=1,6
5     FNAMS(N)=' '
 
C
C--- FIND THE SEARCH PATH STRING THAT POINTS TO THE MODPATH SETUP DIRECTORY
      CALL MPSRCH(IUNAR(14),FILDIR)
 
C
 
C  CALL INITIALIZATION ROUTINE.
C
C  "IBATCH" IS A FLAG INDICATING WHETHER THE RUN HAS INTERACTIVE
C  SCREEN INPUT OR IS "BATCH"
C
C  IBATCH = 0 --> INPUT AT SCREEN
C  IBATCH NOT EQUAL TO 0 --> ALL INPUT READ FROM FILES
C
C  THE VALUE OF IBATCH IS SET IN THE SUBROUTINE "INIT".
C
C
      IF(FILDIR.NE.' ') THEN
      CALL CHOP(FILDIR,LFDR)
      CALL CHOP(FHELP,LFH)
      PHELP= FILDIR(1:LFDR)//FHELP(1:LFH)
      CALL CHOP(FSHELP,LFH)
      PSHELP= FILDIR(1:LFDR)//FSHELP(1:LFH)
      ELSE
      PHELP=FHELP
      PSHELP=FSHELP
      END IF
      CALL KIS(IUNAR(11),IUNAR(12),IUNAR(13),IUNAR(15),I7,RSPFIL,
     1          PHELP,PSHELP,VER,1,PRGNAM)
      CALL GPARAM(1,IBATCH)
      IBATCH=1-IBATCH
      CALL GPARAM(6,ISILNT)
C
C-----------------------------------------------------------------------
C
C  DEFINE FILE CONNECTION CHARACTER STRINGS
C
      NUNIT=17
      DO 1 N=1,NUNIT
      CUNIT(N)=' '
      IUNIT(N)=0
1     CONTINUE
      CUNIT(1)='DIS'
      CUNIT(7)='BUDGET'
      CUNIT(8)='HEAD(BINARY)'
      CUNIT(9)='STR'
      CUNIT(10)='MAIN'
      CUNIT(11)='HEAD'
      CUNIT(12)='CBF'
      CUNIT(13)='LOCATIONS'
      CUNIT(14)='TIME'
      CUNIT(15)='ENDPOINT'
      CUNIT(16)='PATHLINE'
      CUNIT(17)='TIME-SERIES'
C
C  OPEN THE DATA FILES CONTAINING THE BASIC INFORMATION ABOUT THE FLOW
C  SYSTEM. ALSO OPEN STANDARD OUTPUT AND SCRATCH FILES.
C
      CALL FILES(I0,I1,I7,IBATCH,IUNIT,CUNIT,NUNIT,IUNAR,NIUNAR,VER(1))
C
C  RESET THE UNIT NUMBERS FOR THE CBF, LOCATIONS FILE, TIME DATA FILE,
C  ENDPOINT, PATHLINE, AND TIME-SERIES FILES IF ANY OF THOSE FILES WERE
C  SPECIFIED IN THE NAME FILE
      IF(IUNIT(12).NE.0) I10=IUNIT(12)
      IF(IUNIT(13).NE.0) I6=IUNIT(13)
      IF(IUNIT(14).NE.0) I8=IUNIT(14)
      IF(IUNIT(15).NE.0) I3=IUNIT(15)
      IF(IUNIT(16).NE.0) I2=IUNIT(16)
      IF(IUNIT(17).NE.0) I4=IUNIT(17)
C
C  ALLOCATE SPACE FOR ARRAYS
C
      CALL SPACE(LENA,LCQX,LCQY,LCQZ,LCPOR,LCIBOU,LCXMAX,LCDX,LCYMAX,
     1LCDY,LCZBOT,LCZTOP,LCHEAD,LCBUFF,LCLAYC,LCNCON,LCIBUF,
     2LCXLC,LCQSS,LCYLC,LCZLC,LCZLL,LCTOT,LCJLC,LCILC,LCKLC,
     4LCQSTO,
     5LCINI,LCPERL,LCNTS,LCTMX,LCIBST,IUNIT,HDRY,HNOFLO,
     6MAXPTS,ISUM,LAYCBD)
C
C#LAHEY - BEGIN#  ALLOCATE MEMORY TO ARRAY "A"
      ALLOCATE (A(ISUM))
C#LAHEY - END#
 
C
C  EXECUTE TRACKING PROGRAM
C
      CALL DRIVER (A(LCQX),A(LCQY),A(LCQZ),A(LCPOR),A(LCIBOU),A(LCXMAX),
     1A(LCDX),A(LCYMAX),A(LCDY),A(LCZBOT),A(LCZTOP),A(LCHEAD),
     2A(LCBUFF),A(LCLAYC),A(LCNCON),A(LCIBUF),IUNIT,
     3A(LCXLC),A(LCYLC),A(LCZLC),A(LCZLL),A(LCTOT),A(LCJLC),A(LCILC),
     4A(LCKLC),A(LCQSS),A(LCQSTO),
     5A(LCINI),
     6A(LCPERL),A(LCNTS),A(LCTMX),A(LCIBST),HDRY,HNOFLO,VER(1),
     7LAYCBD)
C
	write(*,'(A)') 'Modpath terminated successfully.' ! emrl
	call stopfile  ! emrl
      STOP
      END
C-----END OF ROUTINE----------------------------------------------------
C-----EMRL 5/5/00
      subroutine stopfile
        character*20 stayopen
	  common /emrlstayopen/ stayopen

 	  if (stayopen(1:1).eq.'1') then
          write(*,*) ' '                     ! emrl
          pause
	  endif
      end


      SUBROUTINE GETPATH(NAME,PATH)
      CHARACTER*256 NAME,PATH  ! emrl 80 to 256
      INTEGER*4     COUNT

      COUNT = 256  ! emrl 80 to 256
      PATH = NAME
3000  IF ((COUNT .GT. 0) .AND. (PATH(COUNT:COUNT) .NE. '\').AND.
     *                         (PATH(COUNT:COUNT) .NE. '/')) THEN
        PATH(COUNT:COUNT) = ' '
        COUNT = COUNT - 1
        GO TO 3000
      ENDIF
      END

      SUBROUTINE GETPREFIX(NAME,PREFIX)
      CHARACTER*256 NAME,PREFIX,TEMPNAME  ! emrl 80 to 256
      INTEGER*4     BEGINCOUNT,ENDCOUNT

      BEGINCOUNT = 256  ! emrl 80 to 256
      ENDCOUNT = 256  ! emrl 80 to 256
      TEMPNAME = NAME
3040  IF ((TEMPNAME(ENDCOUNT:ENDCOUNT).NE.'.').AND.
     *    (ENDCOUNT.GT.0)) THEN
        ENDCOUNT = ENDCOUNT - 1
        GO TO 3040
      ENDIF
3050  IF ((TEMPNAME(BEGINCOUNT:BEGINCOUNT).NE.'\').AND.
     *    (TEMPNAME(BEGINCOUNT:BEGINCOUNT).NE.'/').AND.
     *    (BEGINCOUNT.GT.0)) THEN
        BEGINCOUNT = BEGINCOUNT - 1
        GO TO 3050
      ENDIF

      BEGINCOUNT = BEGINCOUNT+1
      ENDCOUNT = ENDCOUNT-1

      PREFIX = TEMPNAME(BEGINCOUNT:ENDCOUNT)

      END

      SUBROUTINE SETNAME(FNAME,WHAT,INDEX,EXT)
      CHARACTER*256 FNAME  ! emrl 80 to 256
      CHARACTER*5   EXT,WHAT,INDEXSTRING
      CHARACTER*256 HEADFILE,INPUTFILE,PATH,PREFIX  ! emrl 80 to 256
      INTEGER*4     INDEX,ENDPREFIX,ENDWHAT
      COMMON/CMDLINE/ HEADFILE,INPUTFILE,PATH,PREFIX

      CALL GETLENGTH(PREFIX,ENDPREFIX)
      ENDWHAT = 5
3070  IF ((WHAT(ENDWHAT:ENDWHAT).EQ.' ').AND.
     *    (ENDPREFIX.GT.1)) THEN
        ENDWHAT = ENDWHAT - 1
        GOTO 3070
      ENDIF
      WRITE(INDEXSTRING,'(I3.3)') INDEX

      FNAME = PREFIX(1:ENDPREFIX)//'_'//WHAT(1:ENDWHAT)//
     *        INDEXSTRING(1:3)//'.'//EXT(1:3)

      END

      SUBROUTINE GETLENGTH(NAME,LENGTH)
      CHARACTER*256 NAME  ! emrl 80 to 256
      INTEGER*4     LENGTH

      LENGTH = 256  ! emrl 80 to 256
3080  IF ((NAME(LENGTH:LENGTH).EQ.' ').AND.
     *    (LENGTH.GT.1)) THEN
        LENGTH = LENGTH - 1
        GOTO 3080
      ENDIF

      END
      

C     SETPATH puts the path onto FNAME
C     You need to have already determined path (ex.using GETPATH)
C     and send that in as PATH. You would usually call this before you open
C     a file.
      SUBROUTINE SETPATH(PATH,FNAME)
      CHARACTER*256 PATH,FNAME,NAME  ! emrl 80 to 256
      INTEGER*4 PATHLENGTH,BEGINNAME,EN
	logical   usequote
C
      usequote=.false.
c     first check if fname already has path
      do i=1,256  ! emrl 80 to 256
        if (fname(i:i).eq.'\' .or.
     &      fname(i:i).eq.'/') then
	    if (usequote) then
	      beginname = 1
3008	      if (fname(beginname:beginname).eq.'"') then
	        beginname = beginname+1
	      else if (en.lt.256) then  ! emrl 80 to 256
	        beginname = beginname+1
	        goto 3008
	      endif
	      en=256  ! emrl 80 to 256
3009	      if (fname(en:en).eq.'"') then
	        en = en-1
	      else if (en.gt.1) then
	        en = en-1
	        goto 3009
	      endif
	    endif
	    fname = fname(beginname:en)
          return
	  endif
	  if (fname(i:i).eq.'"') usequote=.true.
	end do

C     find the length of PATH
      PATHLENGTH = 256  ! emrl 80 to 256
3010  IF ((PATHLENGTH .GT. 1) .AND.
     *    (PATH(PATHLENGTH:PATHLENGTH) .EQ. ' ')) THEN
        PATHLENGTH = PATHLENGTH - 1
        GO TO 3010
      ENDIF

      NAME = FNAME

c      EN = 256
      BEGINNAME = 1
3020  IF (((NAME(BEGINNAME:BEGINNAME).EQ.' ') .OR.
     *      (NAME(BEGINNAME:BEGINNAME).EQ.'"')) .AND.
     *    (BEGINNAME.LT.256)) THEN  ! emrl 80 to 256
        BEGINNAME = BEGINNAME + 1
        GO TO 3020
      ENDIF
	if (name(1:1).eq.'"') usequote=.true.
      EN = BEGINNAME
	if (usequote) then
3030    IF (NAME(EN:EN).NE.'"') THEN
          EN = EN + 1
          GO TO 3030
        else
          EN = EN - 1
        ENDIF
	else
3031    IF (NAME(EN:EN).NE.' ') THEN
          EN = EN + 1
          GO TO 3031
        else
          EN = EN - 1
        ENDIF
	endif

      FNAME = PATH(1:PATHLENGTH)//NAME(BEGINNAME:EN)

      END
C-----EMRL 5/5/00 
